home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / TCPOOConnections.p < prev    next >
Encoding:
Text File  |  1994-08-23  |  21.5 KB  |  947 lines  |  [TEXT/PJMM]

  1. unit TCPOOConnections;
  2.  
  3. { TCPOOConnections © Peter Lewis, April 1993 }
  4.  
  5. interface
  6.  
  7.     uses
  8.         TCPTypes, TCPStuff, MyTypes;
  9.  
  10.     const
  11.         tooManyConnections = -23099;
  12.         timeoutError = -23098;
  13.         failedToOpenError = -23097;
  14.  
  15. { Sequence: }
  16. { new(obj) }
  17. { oe:=obj.Create }
  18. { if oe=noErr then begin }
  19. {   do stuff}
  20. { end; }
  21. { obj.Destroy }
  22.  
  23.     type
  24.         ConnectionBaseObject = object
  25.                 timetodie: boolean; { Set this to have Destroy called at the end of HandleConnection }
  26.                 connection_index: integer; { private! }
  27.                 closedone, terminatedone: boolean;
  28.                 heartbeat_period: longInt; { set to <=0 to disable heartbeats }
  29.                 heartbeat_time: longInt; { set to time of next heartbeat, it is automatically incrememnted by the period }
  30. { To enable heartbeats, set heartbeat_time to TickCount, and heartbeat_period to the period in ticks }
  31.                 timeout_time: longInt; { set to time to timeout TickCount }
  32.                 drp: ptr; { private! }
  33.                 function Create: OSErr;
  34.                 procedure Destroy;
  35.                 procedure HeartBeat;
  36.                 procedure Failed (oe: OSErr);
  37.                 procedure Timeout;
  38.                 procedure Terminate;
  39.                 procedure Close;
  40.                 function HandleConnection: boolean;
  41.             end;
  42.         NameSearchObject = object(ConnectionBaseObject)
  43.                 ip: longInt;
  44.                 function HandleConnection: boolean;
  45.                 override;
  46.                 procedure FindName (hostIP: longInt);
  47.                 procedure FoundName (name: str255; error: OSErr);
  48.             end;
  49.         AddressSearchObject = object(ConnectionBaseObject)
  50.                 object_host: str255;
  51.                 function HandleConnection: boolean;
  52.                 override;
  53.                 procedure FindAddress (hostName: str255);
  54.                 procedure FoundAddress (ip: longInt);
  55.             end;
  56.         UDPObject = object(ConnectionBaseObject)
  57.                 udpcp: UDPConnectionPtr;
  58.                 localport: integer;
  59.                 function CreatePort (buffer_size: longInt; port: integer): OSErr;
  60.                 procedure Close;
  61.                 override;
  62.                 procedure Terminate;
  63.                 override;
  64.                 procedure Destroy;
  65.                 override;
  66.                 function HandleConnection: boolean;
  67.                 override;
  68.                 procedure PacketAvailable (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer);
  69.                 procedure PacketsAvailable (count: integer);
  70.                 function SendPacket (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer; checksum: boolean): OSErr;
  71.             end;
  72.         statusType = (CS_LookingUpAddr, CS_Opening, CS_Established, CS_Closing);
  73.         ConnectionObject = object(ConnectionBaseObject)
  74.                 lookingupname: boolean;
  75.                 active: boolean;
  76.                 thebuffersize: longInt;
  77.                 ourip: longInt;
  78.                 ourport: integer;
  79.                 theirip: longInt;
  80.                 theirport: integer;
  81.                 tcpc: TCPConnectionPtr;
  82.                 status: statusType;
  83.                 object_host: str255;
  84.                 procedure Destroy;
  85.                 override;
  86.                 function HandleConnection: boolean;
  87.                 override;
  88.                 procedure NewConnection (actve: boolean; buffersize: longInt; localport: integer; remotehost: str255; remoteport: integer);
  89.                 procedure NewPassiveConnection (buffersize: longInt; localport: integer);
  90.                 procedure NewActiveConnection (buffersize: longInt; remotehost: str255; remoteport: integer);
  91.                 procedure StartConnection;
  92.                 procedure Close;
  93.                 override;
  94.                 procedure Terminate;
  95.                 override;
  96.                 procedure BeginConnection; { override these }
  97.                 procedure Established;
  98.                 procedure Closing;
  99.                 procedure CharsAvailable (count: longInt);
  100.             end;
  101.         LineConnectionObject = object(ConnectionObject)
  102.                 crlf: CRLFTypes;
  103.                 buffer_len: longInt; { Current number of characters in buffer }
  104.                 buffer: handle; { Size initially set to 512 bytes, change it as you wish }
  105.                 last_check: longInt; { buffer_len when we last checked for a line, don't recheck unless it changes }
  106.                 pushFlag: boolean; { Hack for the occasionally non-pushed lines, set to true every send }
  107.                 line_send_error: OSErr;
  108.                 function Create: OSErr;
  109.                 override;
  110.                 procedure Destroy;
  111.                 override;
  112.                 procedure SendLine (s: str255);
  113.                 procedure LineAvailable (line: str255);
  114.                 function CheckLineAvailable: boolean; { You can override this and use buffer & buffer_len yourself }
  115.                 function HandleConnection: boolean;
  116.                 override;
  117.                 procedure CharsAvailable (count: longInt);
  118.                 override;
  119.             end;
  120.  
  121.     var
  122.         tcp_our_ip: longInt;
  123.         tcp_our_str: str31;
  124.         tcp_our_name: str255;
  125.  
  126.     function InitConnections (findourname: boolean): OSErr;
  127.     procedure FinishConnections;
  128.     function HandleConnections (maxtime: integer): boolean;
  129.     procedure ConnectionsAddrToString (ip: longInt; var addrStr: str255);
  130.     function ConnectionsAddrToStr (ip: longInt): str255;
  131.     function ConnectionsStrToAddr (s: str255; var addr: longInt): boolean;
  132. { You probably wont need these: }
  133.     procedure TerminateConnections;
  134.     procedure CloseConnections;
  135.     function CanQuit: boolean;
  136.  
  137. implementation
  138.  
  139.     uses
  140.         DNR;
  141.  
  142.     const
  143.         TCPCMagic = 'TCPC';
  144.         TCPCBadMagic = 'badc';
  145.  
  146.     const  { Tuning parameters }
  147.         max_connections = 64;
  148.         TO_FindAddress = 40 * 60;
  149.         TO_FindName = 40 * 60;
  150.         TO_ActiveOpen = 20 * 60;
  151.         TO_Closing = longInt(2) * 60 * 60;
  152.         TO_PassiveOpen = longInt(10) * 365 * 24 * 3600 * 60;  { Ten years should be safe enough right? :-) }
  153.  
  154.     type
  155.         myHostInfo = record
  156.                 hi: hostInfo;
  157.                 done: signedByte;
  158.             end;
  159.         myHIP = ^myHostInfo;
  160.  
  161.     type
  162.         connectionRecord = record
  163.                 obj: ConnectionBaseObject;
  164.             end;
  165.  
  166.     var
  167.         connections: array[1..max_connections] of connectionRecord;
  168.         quiting: boolean;
  169.  
  170.     procedure TrashHandle (h: handle);
  171.         var
  172.             p: ptr;
  173.             i: longInt;
  174.     begin
  175.         if (h <> nil) & (h^ <> nil) then begin
  176.             p := h^;
  177.             for i := 1 to GetHandleSize(h) do begin
  178.                 p^ := -27;
  179.                 longInt(p) := longInt(p) + 1;
  180.             end;
  181.         end;
  182.     end;
  183.  
  184.     function MyTCPState (con: TCPConnectionPtr): TCPStateType;
  185.     begin
  186.         if con = nil then
  187.             MyTCPState := T_Closed
  188.         else
  189.             MyTCPState := TCPState(con);
  190.     end;
  191.  
  192.     type
  193.         LookupMyName = object(NameSearchObject)
  194.                 procedure FoundName (name: str255; error: OSErr);
  195.                 override;
  196.             end;
  197.  
  198.     procedure LookupMyName.FoundName (name: str255; error: OSErr);
  199.     begin
  200.         tcp_our_name := name;
  201.     end;
  202.  
  203. {$S Init}
  204.     function InitConnections (findourname: boolean): OSErr;
  205.         var
  206.             oe, ooe: OSErr;
  207.             i: integer;
  208.             lobj: LookupMyName;
  209.     begin
  210.         quiting := false;
  211.         icmp_sent_out := 0;
  212.         icmp_got_back := 0;
  213.         for i := 1 to max_connections do
  214.             connections[i].obj := nil;
  215.         oe := TCPInit;
  216.         if oe = noErr then begin
  217.             oe := OpenResolver;
  218.             if oe = noErr then begin
  219.                 oe := IPGetMyIPAddr(tcp_our_ip);
  220.                 tcp_our_str := ConnectionsAddrToStr(tcp_our_ip);
  221.                 tcp_our_name := tcp_our_str;
  222.                 if findourname then begin
  223.                     new(lobj);
  224.                     lobj.FindName(tcp_our_ip);
  225.                 end;
  226.             end;
  227.             if oe <> noErr then
  228.                 TCPFinish;
  229.         end;
  230.         InitConnections := oe;
  231.     end;
  232. {$S}
  233.  
  234. {$S Term}
  235.     procedure TerminateConnections;
  236.         var
  237.             i: integer;
  238.     begin
  239.         for i := 1 to max_connections do
  240.             if connections[i].obj <> nil then begin
  241.                 if not connections[i].obj.terminatedone then
  242.                     connections[i].obj.Terminate;
  243.             end;
  244.     end;
  245. {$S}
  246.  
  247. {$S Term}
  248.     procedure CloseConnections;
  249.         var
  250.             i: integer;
  251.     begin
  252.         for i := 1 to max_connections do
  253.             if connections[i].obj <> nil then begin
  254.                 connections[i].obj.Close;
  255.             end;
  256.     end;
  257. {$S}
  258.  
  259. {$S Term}
  260.     function CanQuit: boolean;
  261.         var
  262.             i: integer;
  263.     begin
  264.         CanQuit := icmp_sent_out = icmp_got_back;
  265.         for i := 1 to max_connections do
  266.             if connections[i].obj <> nil then begin
  267.                 CanQuit := false;
  268.                 leave;
  269.             end;
  270.     end;
  271.  
  272. {$S Term}
  273.     procedure FinishConnections;
  274.         var
  275.             dummy: boolean;
  276.             er: eventRecord;
  277.     begin
  278.         quiting := true;
  279.         while not CanQuit do begin
  280.             TerminateConnections;
  281.             if HandleConnections(3) then begin
  282.                 dummy := WaitNextEvent(everyEvent, er, 0, nil);
  283.             end
  284.             else
  285.                 dummy := WaitNextEvent(everyEvent, er, 5, nil);
  286.         end;
  287.         CloseResolver;
  288.         TCPFinish;
  289.     end;
  290. {$S}
  291.  
  292.     function ConnectionBaseObject.Create: OSErr;
  293.         var
  294.             i: integer;
  295.             oe: OSErr;
  296.     begin
  297.         MoveHHi(handle(self));
  298.         HLock(handle(self));
  299.         if quiting then begin
  300.             oe := -12;
  301.         end
  302.         else begin
  303.             i := 1;
  304.             while (i <= max_connections) & (connections[i].obj <> nil) do
  305.                 i := i + 1;
  306.             if i <= max_connections then begin
  307.                 timetodie := false;
  308.                 connection_index := i;
  309.                 connections[i].obj := self;
  310.                 heartbeat_period := 0;
  311.                 heartbeat_time := 0;
  312.                 timeout_time := maxLongInt;
  313.                 closedone := false;
  314.                 terminatedone := false;
  315.                 drp := NewPtr(SizeOf(DNRRecord));
  316.                 oe := MemError;
  317.             end
  318.             else begin
  319.                 connection_index := -1;
  320.                 oe := tooManyConnections;
  321.             end;
  322.         end;
  323.         Create := oe;
  324.     end;
  325.  
  326.     procedure ConnectionBaseObject.Destroy;
  327.     begin
  328.         if connection_index > 0 then
  329.             connections[connection_index].obj := nil;
  330.         if drp <> nil then
  331.             DisposePtr(drp);
  332.         TrashHandle(handle(self));
  333.         dispose(self);
  334.     end;
  335.  
  336.     procedure ConnectionBaseObject.HeartBeat;
  337.     begin
  338.     end;
  339.  
  340.     procedure ConnectionBaseObject.Failed (oe: OSErr);
  341.     begin
  342.         timetodie := true;
  343.     end;
  344.  
  345.     procedure ConnectionBaseObject.Timeout;
  346.     begin
  347.         Failed(timeoutError);
  348.     end;
  349.  
  350.     procedure ConnectionBaseObject.Terminate;
  351.     begin
  352.         terminatedone := true;
  353.     end;
  354.  
  355.     procedure ConnectionBaseObject.Close;
  356.     begin
  357.         closedone := true;
  358.     end;
  359.  
  360.     function ConnectionBaseObject.HandleConnection: boolean;
  361.         var
  362.             now: longInt;
  363.     begin
  364.         HandleConnection := false;
  365.         now := TickCount;
  366.         if now > timeout_time then begin
  367.             timeout_time := maxLongInt;
  368.             Timeout;
  369.             HandleConnection := true;
  370.         end
  371.         else if (heartbeat_period > 0) & (now >= heartbeat_time) then begin
  372.             HeartBeat;
  373.             heartbeat_time := heartbeat_time + heartbeat_period;
  374.             HandleConnection := true;
  375.         end;
  376.     end;
  377.  
  378.     procedure AddressSearchObject.FindAddress (hostName: str255);
  379.         var
  380.             oe: OSErr;
  381.     begin
  382.         oe := Create;
  383.         if oe = noErr then begin
  384.             object_host := hostName;
  385.             DNRNameToAddr(hostName, DNRRecordPtr(drp), nil);
  386.             timeout_time := TickCount + TO_FindAddress;
  387.         end;
  388.         if oe <> noErr then begin
  389.             Failed(oe);
  390.             Destroy;
  391.         end;
  392.     end;
  393.  
  394.     procedure AddressSearchObject.FoundAddress (ip: longInt);
  395.     begin
  396.     end;
  397.  
  398.     function AddressSearchObject.HandleConnection: boolean;
  399.     begin
  400.         with DNRRecordPtr(drp)^ do begin
  401.             if ioResult = noErr then begin
  402. {    TCPSetCache(hi, object_host);}
  403.                 FoundAddress(addr);
  404.                 timetodie := true;
  405.                 HandleConnection := true;
  406.             end
  407.             else if ioResult <> inProgress then begin
  408.                 Failed(ioResult);
  409.                 timetodie := true;
  410.                 HandleConnection := true;
  411.             end
  412.             else begin
  413.                 HandleConnection := inherited HandleConnection;
  414.             end;
  415.         end; {with}
  416.     end;
  417.  
  418.     procedure NameSearchObject.FindName (hostIP: longInt);
  419.         var
  420.             oe: OSErr;
  421.             hostname: str255;
  422.     begin
  423.         ip := hostIP;
  424.         oe := Create;
  425.         if oe = noErr then begin
  426.             DNRAddrToName(hostIP, DNRRecordPtr(drp), nil);
  427.             timeout_time := TickCount + TO_FindName;
  428.         end;
  429.         if oe <> noErr then begin
  430.             Failed(oe);
  431.             Destroy;
  432.         end;
  433.     end;
  434.  
  435.     procedure NameSearchObject.FoundName (name: str255; error: OSErr);
  436.     begin
  437.     end;
  438.  
  439.     function NameSearchObject.HandleConnection: boolean;
  440.     begin
  441.         with DNRRecordPtr(drp)^ do begin
  442.             if ioResult <> inProgress then begin
  443.                 FoundName(name, ioResult);
  444.                 timetodie := true;
  445.                 HandleConnection := true;
  446.             end
  447.             else begin
  448.                 HandleConnection := inherited HandleConnection;
  449.             end;
  450.         end; {with}
  451.     end;
  452.  
  453.     procedure ConnectionObject.Established;
  454.     begin
  455.     end;
  456.  
  457.     procedure ConnectionObject.Closing;
  458.     begin
  459.         Close;
  460.     end;
  461.  
  462.     procedure ConnectionObject.CharsAvailable (count: longInt);
  463.     begin
  464.     end;
  465.  
  466.     procedure ConnectionObject.Destroy;
  467.         var
  468.             tmp_tcpc: TCPConnectionPtr;
  469.             oe: OSErr;
  470.     begin
  471.         if tcpc <> nil then begin
  472.             oe := TCPAbort(tcpc);
  473.             tmp_tcpc := tcpc;
  474.             oe := TCPRelease(tmp_tcpc);
  475.         end;
  476.         inherited Destroy;
  477.     end;
  478.  
  479.     procedure ConnectionObject.BeginConnection;
  480.     begin
  481.     end;
  482.  
  483.     procedure ConnectionObject.StartConnection;
  484.         var
  485.             oe: OSErr;
  486.             tmp_tcpc: TCPConnectionPtr;
  487.     begin
  488.         if active then begin
  489.             oe := TCPActiveOpen(tmp_tcpc, thebuffersize, ourport, theirip, theirport, nil);
  490.             timeout_time := TickCount + TO_ActiveOpen;
  491.         end
  492.         else begin
  493.             oe := TCPPassiveOpen(tmp_tcpc, thebuffersize, ourport, theirip, theirport, nil);
  494.             timeout_time := TickCount + TO_PassiveOpen;
  495.         end;
  496.         tcpc := tmp_tcpc;
  497.         status := CS_Opening;
  498.         if oe = noErr then begin
  499.             ourport := TCPLocalPort(tcpc);
  500.             BeginConnection;
  501.         end
  502.         else begin
  503.             Failed(oe);
  504.             timetodie := true;
  505.         end;
  506.     end;
  507.  
  508.     procedure ConnectionObject.NewConnection (actve: boolean; buffersize: longInt; localport: integer; remotehost: str255; remoteport: integer);
  509.         var
  510.             oe: OSErr;
  511.             ip: longInt;
  512.     begin
  513.         status := CS_LookingUpAddr;
  514.         tcpc := nil;
  515.         oe := Create;
  516.         if oe = noErr then begin
  517.             active := actve;
  518.             thebuffersize := buffersize;
  519.             ourport := localport;
  520.             ourip := tcp_our_ip;
  521.             theirip := 0;
  522.             theirport := remoteport;
  523.             ip := 0;
  524.             if (remotehost = '') | ConnectionsStrToAddr(remotehost, ip) then begin
  525.                 if (ip = 0) & active then begin
  526.                     oe := -11;
  527.                 end
  528.                 else begin
  529.                     theirip := ip;
  530.                     DisposePtr(drp);
  531.                     drp := nil;
  532.                     StartConnection;
  533.                 end;
  534.             end
  535.             else begin
  536.                 object_host := remotehost;
  537.                 DNRNameToAddr(remotehost, DNRRecordPtr(drp), nil);
  538.                 timeout_time := TickCount + TO_FindAddress;
  539.             end;
  540.         end;
  541.         if oe <> noErr then begin
  542.             tcpc := nil;
  543.             Failed(oe);
  544.             timetodie := true;
  545.         end;
  546.         if timetodie then
  547.             Destroy;
  548.     end;
  549.  
  550.     procedure ConnectionObject.NewPassiveConnection (buffersize: longInt; localport: integer);
  551.     begin
  552.         NewConnection(false, buffersize, localport, '', 0);
  553.     end;
  554.  
  555.     procedure ConnectionObject.NewActiveConnection (buffersize: longInt; remotehost: str255; remoteport: integer);
  556.     begin
  557.         NewConnection(true, buffersize, 0, remotehost, remoteport);
  558.     end;
  559.  
  560.     procedure ConnectionObject.Close;
  561.         var
  562.             oe: OSErr;
  563.     begin
  564.         if not closedone and (tcpc <> nil) then begin
  565.             oe := TCPClose(tcpc, nil);
  566.             closedone := true;
  567.         end;
  568.     end;
  569.  
  570.     procedure ConnectionObject.Terminate;
  571.         var
  572.             oe: OSErr;
  573.     begin
  574.         if not terminatedone and (tcpc <> nil) then begin
  575.             oe := TCPAbort(tcpc);
  576.             terminatedone := true;
  577.         end;
  578.     end;
  579.  
  580.     function ConnectionObject.HandleConnection: boolean;
  581.         var
  582.             didit: boolean;
  583.             count: longInt;
  584.             state: TCPStateType;
  585.     begin
  586.         didit := false;
  587.         state := MyTCPState(tcpc);
  588.         case status of
  589.             CS_LookingUpAddr:  begin
  590.                 if DNRRecordPtr(drp)^.ioResult = noErr then begin
  591. {    TCPSetCache(myHIP(hip)^.hi, object_host);}
  592.                     theirip := DNRRecordPtr(drp)^.addr;
  593.                     DisposePtr(drp);
  594.                     StartConnection;
  595.                     didit := true;
  596.                 end
  597.                 else if DNRRecordPtr(drp)^.ioResult <> inProgress then begin
  598.                     Failed(DNRRecordPtr(drp)^.ioResult);
  599.                     timetodie := true;
  600.                     didit := true;
  601.                 end;
  602.             end;
  603.             CS_Opening:  begin
  604.                 case state of
  605.                     T_WaitingForOpen, T_Opening, T_Listening: 
  606.                         ;
  607.                     T_Established:  begin
  608.                         Established;
  609.                         status := CS_Established;
  610.                         timeout_time := maxLongInt;
  611.                         didit := true;
  612.                     end;
  613.                     T_PleaseClose, T_Closing, T_Closed:  begin
  614.                         didit := true;
  615.                         Failed(failedToOpenError);
  616.                         timetodie := true;
  617.                     end;
  618.                     otherwise
  619.                         ;
  620.                 end; {case }
  621.             end;
  622.             CS_Established:  begin
  623.                 case state of
  624.                     T_Established:  begin
  625.                         count := TCPCharsAvailable(tcpc);
  626.                         if count > 0 then begin
  627.                             CharsAvailable(count);
  628.                             didit := true;
  629.                         end;
  630.                     end;
  631.                     T_PleaseClose, T_Closing:  begin
  632.                         count := TCPCharsAvailable(tcpc);
  633.                         if count > 0 then begin
  634.                             CharsAvailable(count);
  635.                             didit := true;
  636.                         end
  637.                         else begin
  638.                             Closing;
  639.                             status := CS_Closing;
  640.                             timeout_time := TickCount + TO_Closing;
  641.                             didit := true;
  642.                         end;
  643.                     end;
  644.                     T_Closed:  begin
  645.                         Closing;
  646.                         status := CS_Closing;
  647.                         timeout_time := TickCount + TO_Closing;
  648.                         didit := true;
  649.                     end;
  650.                     otherwise
  651.                         ;
  652.                 end;
  653.             end;
  654.             CS_Closing:  begin
  655.                 case state of
  656.                     T_PleaseClose, T_Closing, T_Established:  begin
  657.                         count := TCPCharsAvailable(tcpc);
  658.                         if count > 0 then begin
  659.                             CharsAvailable(count);
  660.                             didit := true;
  661.                         end;
  662.                     end;
  663.                     T_Closed:  begin
  664.                         timetodie := true;
  665.                         didit := true;
  666.                     end;
  667.                     otherwise
  668.                         ;
  669.                 end;
  670.             end;
  671.             otherwise
  672.                 ;
  673.         end;
  674.         didit := didit | inherited HandleConnection;
  675.         HandleConnection := didit;
  676.     end;
  677.  
  678.     function LineConnectionObject.Create: OSErr;
  679.     begin
  680.         crlf := CL_CRLF;
  681.         buffer := NewHandle(512);
  682.         buffer_len := 0;
  683.         last_check := -1;
  684.         pushFlag := true;
  685.         line_send_error := noErr;
  686.         Create := inherited Create;
  687.     end;
  688.  
  689.     procedure LineConnectionObject.Destroy;
  690.     begin
  691.         DisposeHandle(buffer);
  692.         inherited Destroy;
  693.     end;
  694.  
  695.     procedure LineConnectionObject.SendLine (s: str255);
  696.         var
  697.             oe: OSErr;
  698.     begin
  699.         if crlf <> CL_LF then
  700.             s := concat(s, cr);
  701.         if crlf <> CL_CR then
  702.             s := concat(s, lf);
  703.         oe := TCPSendAsync(tcpc, @s[1], length(s), pushFlag, nil);
  704.         if line_send_error = noErr then
  705.             line_send_error := oe;
  706.         pushFlag := true;
  707.     end;
  708.  
  709.     procedure LineConnectionObject.LineAvailable (line: str255);
  710.     begin
  711.     end;
  712.  
  713.     procedure LineConnectionObject.CharsAvailable (count: longInt);
  714.         var
  715.             space: longint;
  716.             oe: OSErr;
  717.             dummy: boolean;
  718.     begin
  719.         space := GetHandleSize(buffer) - buffer_len;
  720.         if count > space then
  721.             count := space;
  722.         if count > 32767 then
  723.             count := 32767;
  724.         if count > 0 then begin
  725.             HLock(buffer);
  726.             oe := TCPRawReceiveChars(tcpc, ptr(ord(buffer^) + buffer_len), count);
  727.             HUnlock(buffer);
  728.             buffer_len := buffer_len + count;
  729.             dummy := CheckLineAvailable;
  730.         end;
  731.     end;
  732.  
  733.     function LineConnectionObject.CheckLineAvailable: boolean;
  734.         var
  735.             len, l: longInt;
  736.             p: ptr;
  737.             s: str255;
  738.     begin
  739.         CheckLineAvailable := false;
  740.         if (buffer_len > 0) & (buffer_len <> last_check) then begin
  741.             p := buffer^;
  742.             len := 0;
  743.             while (len < buffer_len) & (len < 255) & (p^ <> ord(lf)) & (p^ <> ord(cr)) do begin
  744.                 p := ptr(ord(p) + 1);
  745.                 len := len + 1;
  746.             end;
  747.             if (len = 255) | ((len < buffer_len) & ((p^ = ord(lf)) or (p^ = ord(cr)))) then begin
  748. {$PUSH}
  749. {$R-}
  750.                 s[0] := chr(len);
  751.                 BlockMove(buffer^, @s[1], len);
  752. {$POP}
  753.                 if (len < buffer_len) & (p^ = ord(cr)) then begin
  754.                     p := ptr(ord(p) + 1);
  755.                     len := len + 1;
  756.                 end;
  757.                 if (len < buffer_len) & (p^ = ord(lf)) then begin
  758.                     p := ptr(ord(p) + 1);
  759.                     len := len + 1;
  760.                 end;
  761.                 BlockMove(p, buffer^, buffer_len - len);
  762.                 buffer_len := buffer_len - len;
  763.                 LineAvailable(s);
  764.                 CheckLineAvailable := true;
  765.                 last_check := -1;
  766.             end
  767.             else begin
  768.                 last_check := buffer_len;
  769.             end;
  770.         end;
  771.     end;
  772.  
  773.     function LineConnectionObject.HandleConnection: boolean;
  774.     begin
  775.         HandleConnection := inherited HandleConnection | CheckLineAvailable;
  776.     end;
  777.  
  778.     function UDPObject.CreatePort (buffer_size: longInt; port: integer): OSErr;
  779.         var
  780.             oe: OSErr;
  781.             tmp_udpcp: UDPConnectionPtr;
  782.     begin
  783.         oe := Create;
  784.         if oe = noErr then begin
  785.             oe := UDPCreate(tmp_udpcp, buffer_size, port);
  786.             udpcp := tmp_udpcp;
  787.             localport := port;
  788.             timeout_time := maxLongInt;
  789.         end;
  790.         if oe <> noErr then begin
  791.             udpcp := nil;
  792.             Destroy;
  793.         end;
  794.         CreatePort := oe;
  795.     end;
  796.  
  797.     procedure UDPObject.Terminate;
  798.     begin
  799.         timetodie := true;
  800.     end;
  801.  
  802.     procedure UDPObject.Close;
  803.         var
  804.             tmp_udpcp: UDPConnectionPtr;
  805.             oe: OSErr;
  806.     begin
  807.         if udpcp <> nil then begin
  808.             tmp_udpcp := udpcp;
  809.             oe := UDPRelease(tmp_udpcp);
  810.             udpcp := nil;
  811.         end;
  812.         timetodie := true;
  813.     end;
  814.  
  815.     procedure UDPObject.Destroy;
  816.     begin
  817.         if udpcp <> nil then begin
  818.             Close;
  819.         end;
  820.         inherited Destroy;
  821.     end;
  822.  
  823.     procedure UDPObject.PacketAvailable (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer);
  824.     begin
  825.     end;
  826.  
  827.     procedure UDPObject.PacketsAvailable (count: integer);
  828.         var
  829.             oe: OSErr;
  830.             remoteIP: longInt;
  831.             remoteport: integer;
  832.             datap: ptr;
  833.             datalen: integer;
  834.             u: UDPConnectionPtr;
  835.     begin
  836.         oe := UDPRead(udpcp, 1, remoteIP, remoteport, datap, datalen);
  837.         if oe = noErr then begin
  838.             u := udpcp;
  839.             PacketAvailable(remoteIP, remoteport, datap, datalen);
  840. { self may be nil now }
  841.             oe := UDPReturnBuffer(u, datap);
  842.         end;
  843.     end;
  844.  
  845.     function UDPObject.SendPacket (remoteIP: longInt; remoteport: integer; datap: ptr; datalen: integer; checksum: boolean): OSErr;
  846.     begin
  847.         SendPacket := UDPWrite(udpcp, remoteIP, remoteport, datap, datalen, checksum);
  848.     end;
  849.  
  850.     function UDPObject.HandleConnection: boolean;
  851.         var
  852.             didit: boolean;
  853.             count: longInt;
  854.     begin
  855.         didit := false;
  856.         if udpcp <> nil then begin
  857.             count := UDPDatagramsAvailable(udpcp);
  858.             if count > 0 then begin
  859.                 PacketsAvailable(count);
  860.                 didit := true;
  861.             end;
  862.         end;
  863.         HandleConnection := didit | inherited HandleConnection;
  864.     end;
  865.  
  866.     function HandleConnections (maxtime: integer): boolean;
  867.         var
  868.             did, didany: boolean;
  869.             start: longInt;
  870.             i: integer;
  871.     begin
  872.         start := TickCount;
  873.         didany := false;
  874.         repeat
  875.             did := false;
  876.             for i := 1 to max_connections do begin
  877.                 if connections[i].obj <> nil then begin
  878.                     if connections[i].obj.HandleConnection then begin
  879.                         did := true;
  880.                         didany := true;
  881.                     end;
  882.                     if (connections[i].obj <> nil) & (connections[i].obj.timetodie) then begin
  883.                         connections[i].obj.Destroy;
  884.                     end;
  885.                 end;{if}
  886.             end; {for}
  887.         until not did or (TickCount >= start + maxtime);
  888.         HandleConnections := didany;
  889.     end;
  890.  
  891.     function ConnectionsStrToAddr (s: str255; var addr: longInt): boolean;
  892.         var
  893.             good: boolean;
  894.         procedure Get1;
  895.             var
  896.                 b: integer;
  897.         begin
  898.             if (length(s) = 0) | not (s[1] in ['0'..'9']) then
  899.                 good := false
  900.             else begin
  901.                 b := ord(s[1]) - 48;
  902.                 s := copy(s, 2, 255);
  903.                 if (s <> '') & (s[1] in ['0'..'9']) then begin
  904.                     b := b * 10 + ord(s[1]) - 48;
  905.                     s := copy(s, 2, 255);
  906.                 end;
  907.                 if (s <> '') & (s[1] in ['0'..'9']) then begin
  908.                     b := b * 10 + ord(s[1]) - 48;
  909.                     s := copy(s, 2, 255);
  910.                 end;
  911.                 if (s <> '') & (s[1] = '.') then begin
  912.                     s := copy(s, 2, 255);
  913.                 end;
  914.                 if b > 255 then begin
  915.                     good := false;
  916.                     b := 0; { avoid overflow error? }
  917.                 end;
  918.                 addr := BOR(BSL(addr, 8), b);
  919.             end;
  920.         end;
  921.     begin
  922.         good := true;
  923.         addr := 0;
  924.         Get1;
  925.         Get1;
  926.         Get1;
  927.         Get1;
  928.         good := good & (s = '');
  929.         if not good then
  930.             addr := 0;
  931.         ConnectionsStrToAddr := good;
  932.     end;
  933.  
  934.     procedure ConnectionsAddrToString (ip: longInt; var addrStr: str255);
  935.     begin
  936.         AddrToStr(ip, addrStr);
  937.     end;
  938.  
  939.     function ConnectionsAddrToStr (ip: longInt): str255;
  940.         var
  941.             s: str255;
  942.     begin
  943.         AddrToStr(ip, s);
  944.         ConnectionsAddrToStr := s;
  945.     end;
  946.  
  947. end.